home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d12
/
vol7n2.arc
/
TP4.FIG
< prev
Wrap
Text File
|
1987-12-23
|
20KB
|
684 lines
Fig. A -- Heading for an Interrupt Procedure
PROCEDURE foo(_Flags, _CS, _IP, _AX, _BX, _CX, _DX, _SI, _DI, _DS, _ES,
_BP:Word);INTERRUPT;
Fig. B -- Special prelude and postlude code created by TP4 for an Interrupt
Procedure
50 PUSH AX
53 PUSH BX
51 PUSH CX
52 PUSH DX
56 PUSH SI
57 PUSH DI
1E PUSH DS
06 PUSH ES
55 PUSH BP
89E5 MOV BP,SP
81ECxxxx SUB SP,LocalSize
B8yyyy MOV AX,SEG DATA
8ED8 MOV DS,AX
{Body of procedure goes here}
89EC MOV SP,BP
5D POP BP
07 POP ES
1F POP DS
5F POP DI
5E POP SI
5A POP DX
59 POP CX
5B POP BX
58 POP AX
CF IRET
Fig. C -- An chaining Interrupt Procedure
PROGRAM Shift_Key_Pressed;
Uses crt, dos, hexx;
(*The hexx Unit is described elsewhere in this article*)
VAR
Kbd_Vec, Exit_Vec : pointer;
CONST
Kbd_Int = 9;
(* Scan codes for seven shift keys *)
SC_LeftShift = 42;
SC_RightShift = 54;
SC_CtrlShift = 29;
SC_AltShift = 56;
SC_NumLock = 69;
SC_ScrollLock = 70;
SC_CapsLock = 58;
SKP : Boolean = False;
which : Byte = 0;
{$F+} PROCEDURE My_Exit; {$F-}
BEGIN
SetIntVec(Kbd_Int, Kbd_vec); {restore OLD INT9}
IF (ExitCode <> 0) OR (ErrorAddr <> NIL) THEN
BEGIN
Assign(Output, '');
Rewrite(Output);
WriteLn(#7);
IF ExitCode = $FF THEN
WriteLn('USER BREAK')
ELSE
BEGIN
Write('Critical Error # ', HEX(ExitCode));
Write(' AT PROGRAM LOCATION ');
WriteLn(Hex(Seg(ErrorAddr^)), ':', Hex(Ofs(ErrorAddr^)));
END;
END;
ExitProc := Exit_Vec; {restore previous ExitProc}
END;
PROCEDURE CLI; INLINE($FA); {INLINE procedures are handy!}
PROCEDURE STI; INLINE($FB);
PROCEDURE INT9_ISR(_Flags, _CS, _IP, _AX, _BX, _CX, _DX,
_SI, _DI, _DS, _ES, _BP : word);
INTERRUPT;
BEGIN
INLINE(
$9C/ {PUSHF ;save flags }
$E4/$60/ {IN AL, 60h ;Read the keyboard port }
$3C/SC_CapsLock/ {CMPB AL,SC_CapsLock }
$74/$1F/ {JZ Was_Pressed }
$3C/SC_LeftShift/ {CMPB AL,SC_LeftShift }
$74/$1B/ {JZ Was_Pressed }
$3C/SC_RightShift/ {CMPB AL,SC_RightShift}
$74/$17/ {JZ Was_Pressed }
$3C/SC_CtrlShift/ {CMPB AL,SC_CtrlShift }
$74/$13/ {JZ Was_Pressed }
$3C/SC_AltShift/ {CMPB AL,SC_AltShift }
$74/$0F/ {JZ Was_Pressed }
$3C/SC_NumLock/ {CMPB AL,SC_NumLock }
$74/$0B/ {JZ Was_Pressed }
$3C/SC_ScrollLock/ {CMPB AL,SC_ScrollLock}
$74/$07/ {JZ Was_Pressed }
{IF you didn't jump by now, it wasn't a shift key}
$C6/$06/SKP/$00/ {MOVB SKP,0 ;set SKP to false }
$EB/$08/ {JMP To_Normal}
{Was_Pressed}
$C6/$06/SKP/$01/ {MOVB SKP,1 ;set SKP to true }
$A2/which/ {MOVB which,AL ;remember WHICH key }
{To_Normal}
$9D/ {POPF ;Get back saved flags }
$A1/> Kbd_vec+2/ {MOV AX,Kbd_vec+2 ; vector segment }
$8B/$1E/> Kbd_vec/ {MOV BX,Kbd_vec ; vector offset }
$87/$5E/$0E/ {XCHG BX,[BP+14] ; switch ofs/bx }
$87/$46/$10/ {XCHG AX,[BP+16] ; switch seg/ax }
$8B/$E5/ {MOV SP,BP ;UNdo what TURBO did at }
$5D/ {POP BP ;start of this routine}
$07/ {POP ES ;It does a lot more than TP3!}
$1F/ {POP DS}
$5F/ {POP DI}
$5E/ {POP SI}
$5A/ {POP DX}
$59/ {POP CX}
$CB {RETF ; effectively "JMP [Kbd_vec]" }
);
END;
FUNCTION ShiftKeyPressed : Boolean;
(* ======================================= *)
(* Returns the value of flag variable SKP, *)
(* and resets it to FALSE *)
(* ======================================= *)
BEGIN
CLI; {Don't want it changing DURING this!}
ShiftKeyPressed := SKP;
SKP := False;
STI; {OK, can change now}
END;
FUNCTION Read_SKP : Byte;
(* ================================== *)
(* Returns the value of flag variable *)
(* "WHICH", and resets it to 0 *)
(* ================================== *)
BEGIN
CLI; {Don't want it changing DURING this!}
Read_SKP := which;
which := 0;
STI; {OK, can change now}
END;
PROCEDURE Do_Demo;
BEGIN
ClrScr;
WriteLn(' KEYBOARD INTERRUPT DEMO "Shift Keys"');
WriteLn(' ====================================');
WriteLn;
Write(' Press the various shift keys on the ');
WriteLn('keyboard. The normal "KeyPressed"');
Write(' function doesn''t notice these keys. ');
WriteLn('But the new "ShiftKeyPressed"');
WriteLn(' notices! Hit <Ctrl><Break> to quit.');
REPEAT
REPEAT UNTIL KeyPressed OR ShiftKeyPressed;
WHILE KeyPressed DO Write(ReadKey);
CASE Read_SKP OF
SC_LeftShift : WriteLn('Left Shift');
SC_RightShift : WriteLn('Right Shift');
SC_CtrlShift : WriteLn('Control Shift');
SC_AltShift : WriteLn('Alt Shift');
SC_NumLock : WriteLn('Num Lock');
SC_ScrollLock : WriteLn('Scroll Lock');
SC_CapsLock : WriteLn('Caps Lock');
END;
UNTIL False; {Only way out is ^Break}
END;
BEGIN
CheckBreak := True;
GetIntVec(Kbd_Int, Kbd_Vec); {save "old" INT9}
SetIntVec(Kbd_Int, @INT9_ISR); {install new}
Exit_Vec := ExitProc; {save old ExitProc}
ExitProc := @My_Exit; {install new}
Do_Demo; {show yer stuff!}
END.
Fig. D -- An Interrupt Procedure that replaces Interrupt 16h
PROGRAM New_I16;
Uses crt, dos, hexx;
(*The hexx Unit is described elsewhere in this article*)
VAR
Kbd_Vec, Exit_Vec : pointer;
CONST
Kbd_Int = $16;
{$F+} PROCEDURE My_Exit; {$F-}
BEGIN
SetIntVec(Kbd_Int, Kbd_vec); {restore OLD INT16}
IF (ExitCode <> 0) OR (ErrorAddr <> NIL) THEN
BEGIN
Assign(Output, '');
Rewrite(Output);
WriteLn(#7);
IF ExitCode = $FF THEN
WriteLn('USER BREAK')
ELSE
BEGIN
Write('Critical Error # ', HEX(ExitCode));
Write(' AT PROGRAM LOCATION ');
WriteLn(Hex(Seg(ErrorAddr^)), ':', Hex(Ofs(ErrorAddr^)));
END;
END;
ExitProc := Exit_Vec; {restore previous ExitProc}
END;
PROCEDURE CLI; INLINE($FA); {INLINE procedures are NICE!}
PROCEDURE STI; INLINE($FB);
PROCEDURE NOP; INLINE($90);
PROCEDURE INT16_ISR(_Flags, _CS, _IP, _AX, _BX, _CX, _DX,
_SI, _DI, _DS, _ES, _BP : word);
INTERRUPT;
(*THIS procedure simply duplicates the function of (un-enhanced BIOS)
INT 16h. But it does it totally using Turbo Pascal!*)
CONST
Zero_Flag = $40;
BIOS_Data = $40;
VAR
Buffer_Head : Integer ABSOLUTE BIOS_Data : $001A;
Buffer_Tail : Integer ABSOLUTE BIOS_Data : $001C;
Buffer_Start : Integer ABSOLUTE BIOS_Data : $0080;
Buffer_End : Integer ABSOLUTE BIOS_Data : $0082;
KB_Flag : Byte ABSOLUTE BIOS_Data : $0017;
BEGIN
STI;
CASE Hi(_AX) OF
0 : BEGIN (*Read key (wait for it)*)
REPEAT
STI; NOP; CLI;
UNTIL Buffer_Head <> Buffer_Tail;
_AX := MemW[BIOS_Data : Buffer_Head];
INC(Buffer_Head, 2);
IF Buffer_Head > Buffer_End THEN
Buffer_Head := Buffer_Start;
STI;
END;
1 : BEGIN (* Was a key pressed?*)
CLI;
IF Buffer_Head = Buffer_Tail THEN
_Flags := _Flags OR Zero_Flag
ELSE
BEGIN
_Flags := _Flags AND NOT(Zero_Flag);
_AX := MemW[BIOS_Data:Buffer_Head];
END;
STI;
END;
2 : _AX := KB_Flag; (*Return shift states*)
END;
END;
PROCEDURE Do_Demo;
VAR
CH : Char;
L : STRING[255];
I : Integer;
BEGIN
WriteLn('Replacement keyboard interrupt is installed.');
Write('PRESS any key to continue....');
REPEAT UNTIL KeyPressed;
CH := ReadKey;
WriteLn(CH);
Write('Enter your name: ');
ReadLn(L);
WriteLn('Hi, ', L);
Write('Enter an integer: ');
ReadLn(I);
WriteLn('You entered ', I);
END;
BEGIN
ClrScr;
CheckBreak := True;
GetIntVec(Kbd_Int, Kbd_Vec); {save "old" INT16}
SetIntVec(Kbd_Int, @INT16_ISR); {install new}
Exit_Vec := ExitProc; {save old ExitProc}
ExitProc := @My_Exit; {install new}
Do_Demo; {show yer stuff!}
{The interrupt gets restored in the ExitProc}
END.
Fig. E -- One way to call a procedure within INLINE code
PROGRAM ProcParmDemo;
VAR P : pointer;
{$F+}
PROCEDURE aproc;
BEGIN
WriteLn('I am a procedure!');
END;
{$F-}
PROCEDURE Call(Pro : pointer);
BEGIN
INLINE($FF/$5E/$04); {CALL FAR [BP+4]}
END;
BEGIN
P := @aproc;
call(P);
END.
Fig. F -- Fast keypress detection using an INLINE directive
PROGRAM InlineDirective1;
USES crt;
VAR
CH : Char;
count : LongInt;
PROCEDURE FastKey; INLINE
($31/$C0/ {XOR AX,AX}
$8E/$C0/ {MOV ES,AX}
$26/$A1/$1A/$04/ {MOV AX,ES:[041A]}
$26/$3B/$06/$1C/$04/ {CMP AX,ES:[041C]}
$74/$03); {JZ $+3}
PROCEDURE GetCh;
BEGIN CH := UpCase(ReadKey); END;
BEGIN
WriteLn('Press any key to start, "Q" to Quit');
CH := ReadKey;
WriteLn('Looping....');
CH := #0;
count := 0;
REPEAT
FastKey;
GetCh;
Inc(Count);
UNTIL CH = 'Q';
WriteLn('IN that time I performed ', count, ' repetitions');
END.
Fig. G -- An INLINE directive with arguments
PROGRAM LongMulDemo;
VAR
X, Y : Integer;
FUNCTION LongMul(X, Y : Integer) : LongInt;
(* Turbo pushes X and Y on the stack *)
INLINE(
$58/ {POP AX ;Pop Y }
$5A/ {POP DX ;Pop X }
$F7/$EA); {IMUL DX ;Result in DX:AX = X*Y}
BEGIN
X := MaxInt; Y := MaxInt;
WriteLn('X is ', X, ' and Y is ', Y);
WriteLn('X*Y=', X*Y, ' -- wrong because it''s truncated to integer.');
WriteLn('LongMul(X,Y)=', LongMul(X, Y));
WriteLn('LongInt(X)*Y=', LongInt(X)*Y);
END.
Fig. H -- Example of a shared data type for inter-process communication
TYPE
PassData = RECORD
ID : string[8];
status : Integer;
DataFileName : string[64];
END;
Fig. I -- An ExitProc gets control when the program ends.
{$R+}
PROGRAM Exit_Proc_Demo;
USES Crt, hexx;
(*The hexx Unit is described elsewhere in this article*)
VAR
ExitVec : Pointer;
W : Word;
{$F+} PROCEDURE My_ExitProc; {$F-}
BEGIN
IF (ExitCode <> 0) OR (ErrorAddr <> NIL) THEN
BEGIN
Assign(Output, ''); (*Use DOS Standard Output*)
Rewrite(Output);
Write(#7'Abnormal exit: ');
IF ExitCode = $FF THEN
WriteLn('USER BREAK')
ELSE
BEGIN
Write('Critical Error # ', HEX(ExitCode));
Write(' at program location ');
WriteLn(HEX(Seg(ErrorAddr^)), ':', Hex(Ofs(ErrorAddr^)));
END;
END
ELSE WriteLn('Normal exit. ');
ExitProc := ExitVec; {restore previous ExitProc}
END;
BEGIN
CheckBreak := True;
ExitVec := ExitProc;
ExitProc := @My_ExitProc;
WriteLn('Enter a WORD value:');
ReadLn(W);
END.
Fig. J -- The TextRec TYPE corresponds to the structure of a TEXT file variable
TYPE
CharBuf = array[0..127] of char;
TextRec = RECORD
Handle : Word;
Mode : Word;
BufSize : Word;
Private : Word;
BufPos : Word;
BufEnd : Word;
BufPtr : ^CharBuf;
OpenFunc : pointer;
InOutFunc : pointer;
FlushFunc : pointer;
CloseFunc : pointer;
UserData : Array[1..16] of byte;
Name : Array[0..79] of char;
Buffer : CharBuf;
END;
Fig. K -- Using a simulated text file to convert any number of variables into a
single string variable
PROGRAM Usr_file;
USES Crt;
CONST
UsrSiz = 255;
fmClosed = $D7B0; {"magic" internal codes for TP4}
fmInput = $D7B1;
fmOutput = $D7B2;
fmInOut = $D7B3;
IO_NotOutput = $104;
IO_FileFull = $FB; {You wrote > 255 characters}
IO_Invalid = $FC; {You attempted an invalid operation}
TYPE
String255 = STRING[255];
CharBuf = ARRAY[0..127] OF Char;
FakeFile = ARRAY[0..UsrSiz] OF Char;
TextRec = RECORD
Handle : Word;
Mode : Word;
BufSize : Word;
Private : Word;
BufPos : Word;
BufEnd : Word;
BufPtr : ^CharBuf;
OpenFunc : pointer;
InOutFunc : pointer;
FlushFunc : pointer;
CloseFunc : pointer;
{16 bytes for User Data. We use
8 of them}
UFilePos : Word;
UFileSiz : Word;
Data : ^FakeFile;
UserData : ARRAY[1..8] OF Byte;
Name : ARRAY[0..79] OF Char;
Buffer : CharBuf;
END;
VAR
UsrFile : Text;
CH : Char;
N, D : Integer;
{$F+} {Compile functions as FAR routines}
FUNCTION UsrClose(VAR F : TextRec) : Integer;
(* "Closes" the UsrFile by deallocating its buffer. *)
(* Always returns 0, meaning success. *)
BEGIN
Dispose(F.data);
UsrClose := 0;
END;
FUNCTION UsrOutput(VAR F : TextRec) : Integer;
(* Output to the "file" consists of moving characters from *)
(* the built-in TextRec buffer to the outside buffer and *)
(* adjusting the appropriate pointers. *)
BEGIN
UsrOutput := 0;
WITH F DO
IF mode = fmOutput THEN
BEGIN
IF UFilePos+BufPos >= UsrSiz THEN UsrOutput := IO_FileFull
ELSE
BEGIN
Move(BufPtr^, Data^[UFilePos], BufPos);
UFilePos := UFilePos+BufPos;
IF UFilePos > UFileSiz THEN UFileSiz := UFilePos;
BufPos := 0;
END;
END
ELSE
IF mode = fmClosed THEN UsrOutput := IO_NotOutput
ELSE UsrOutput := IO_Invalid;
END;
FUNCTION UsrOpen(VAR F : TextRec) : Integer;
(* This particular kind of "file" can _only_ be opened with *)
(* ReWrite, never with Reset. *)
BEGIN
UsrOpen := 0;
WITH F DO
IF mode = fmOutput THEN
BEGIN
UFileSiz := 0;
UFilePos := 0;
END
ELSE UsrOpen := IO_Invalid;
END;
{$F-}{Stop compiling functions as FAR routines}
FUNCTION ReadUsr(VAR F : Text) : String255;
(* Grab the entire contents of the UsrFile and reset it *)
(* to empty. *)
VAR Temp : String255;
BEGIN
WITH TextRec(F) DO
BEGIN
Move(Data^, Temp[1], UFileSiz);
Temp[0] := Chr(UFileSiz);
UFileSiz := 0;
UFilePos := 0;
END;
ReadUsr := temp;
END;
PROCEDURE AssignUsr(VAR F : Text);
BEGIN
WITH TextRec(F) DO
BEGIN
Mode := fmClosed;
BufSize := 127;
BufPtr := @buffer;
OpenFunc := @UsrOpen;
CloseFunc := @UsrClose;
InOutFunc := @UsrOutput;
FlushFunc := @UsrOutput;
Name[0] := #0;
UFileSiz := 0;
UFilePos := 0;
New(Data);
END;
END;
BEGIN
ClrScr;
Write('Now writing several variables to "UsrFile" -- ');
WriteLn('they will become a single STRING.');
AssignUsr(UsrFile);
Rewrite(UsrFile);
Write(UsrFile, 'PI/4 = ', Pi/4:1:11);
Write(UsrFile, ' The biggest Long Integer is ', MaxLongInt);
WriteLn('Press a key to see the result.');
CH := ReadKey;
WriteLn; WriteLn('"', ReadUsr(UsrFile), '"'); WriteLn;
WriteLn('Now the UsrFile is clear, ready to accept input again');
N := 355; D := 113;
Write(UsrFile, N, '/', D, ' ', Chr(247), ' PI.');
Write(UsrFile, ' PI=', Pi:1:11, ' and ', N, '/', D, '=', N/D:1:11);
WriteLn('Press a key to see the result.');
CH := ReadKey;
WriteLn; WriteLn('"', ReadUsr(UsrFile), '"'); WriteLn;
WriteLn('NOW to overload the UsrFile -- we will get a special I/O error');
WriteLn('Press a key to see the result.');
CH := ReadKey;
FOR N := 1 TO 9 DO
Write(UsrFile, 'THIS string has 32 characters. ');
WriteLn; WriteLn('"', ReadUsr(UsrFile), '"'); WriteLn;
END.
Fig. L -- Using a "fake OBJ" to incorporate a data file directly into a program.
PROGRAM Fake_Obj;
{$L INFO.OBJ}
PROCEDURE InfoProc; EXTERNAL;
PROCEDURE DisplayInfo(P : Pointer);
VAR N : Integer;
S,O : Word;
BEGIN
N := -1;
S := Seg(P^);
O := Ofs(P^);
REPEAT
Inc(N);
Write(Chr(MEM[S:O+N]));
UNTIL (MEM[S:O+succ(N)]) = 26;
END;
BEGIN
DisplayInfo(@InfoProc);
END.
Fig. M -- TP4 offers conditional compilation
PROGRAM CondComp;
{$IFDEF CPU87}
{$N+} { turn on use of 8087 math package }
VAR
X : Single; { single precision IEEE real }
Y : Double; { double precision IEEE real }
Z : Extended; { extended IEEE real }
{$ELSE}
VAR
X : Real; { no 8087 so define all of them as 6 byte }
Y : Real; { reals }
Z : Real;
{$ENDIF}
BEGIN
WriteLn('X takes ', SizeOf(X), ' bytes.');
WriteLn('Y takes ', SizeOf(Y), ' bytes.');
WriteLn('Z takes ', SizeOf(Z), ' bytes.');
END.
Fig. N -- Demonstrating TP4's direct video I/O
PROGRAM FastWrite;
Uses Crt;
VAR
AString : String[79];
N : Byte;
BEGIN
FOR N := 1 to 79 DO AString[N] := 'O';
AString[0] := #79;
ClrScr;
WriteLn('Press <Return> for a demo of fast screen writing');
ReadLn; GotoXY(1,1);
LowVideo;
FOR N := 1 to 24 DO WriteLn(AString);
FOR N := 1 to 79 DO AString[N] := 'X';
GotoXY(1,1); NormVideo;
WriteLn('Press <Return> for a demo of ordinary writing');
ReadLn; GotoXY(1,1);
DirectVideo := False;
FOR N := 1 to 24 DO WriteLn(AString);
END.
Fig O. -- A simple UNIT for hexadecimal conversions
UNIT Hexx;
Interface
TYPE
string2 = STRING[2];
string4 = STRING[4];
CONST
HexDigit : ARRAY[0..15] OF Char = '0123456789ABCDEF';
FUNCTION HexByte(B : Byte) : string2;
FUNCTION Hex(I : Integer) : string4;
Implementation
FUNCTION HexByte(B : Byte) : string2;
BEGIN
HexByte := HexDigit[B SHR 4]+HexDigit[B AND $F];
END;
FUNCTION Hex(I : Integer) : string4;
BEGIN
Hex := HexByte(Hi(I))+HexByte(Lo(I));
END;
END.